home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TURB_VIS
/
TVMENU2
/
MENUTEST.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-07-04
|
3KB
|
82 lines
{ Purpose: Program to illustrate the use of Tickable menu items.
Compile notes: I have all my standard text for message boxes and dialogs
in a resource file that is initialised before object MyApp
is initialised. To compile this program with standard TV
units, remove the reference to the Messages unit in the
'uses' clause and remove the procedure calls to InitMessages
and DoneMessages in the program procedure.
Use freely if you find it useful.
(C) Bill Seddon 1992 CompuServe 100111,557 }
Program MenuTest;
uses App, Drivers, Menus, MenuTick, Messages, Objects, Views;
const
cmMenuItem1 = 100;
cmMenuItem2 = 101;
cmMenuItem3 = 102;
type
PMyApp = ^TMyApp;
TMyApp = object( TApplication )
Procedure HandleEvent( var Event : TEvent ); virtual;
Procedure InitMenuBar; virtual;
end;
{== TMyApp methods ==========================================================}
{ Here HandleEvent is used to change the mark on the selected MenuItem (see
below). In reality, this will be done in some more meaningful way in the
HandleEvent (or method called by HandleEvent) of an object that responds to
particular a particulat command. Here it just toggles the check mark }
Procedure TMyApp.HandleEvent( var Event : TEvent );
begin
if ( Event.What = evCommand ) then
if ( Event.Command in [cmMenuItem1..cmMenuItem3] ) then
begin
if MenuItemIsChecked( MenuBar^.Menu, Event.Command ) then
ClearMenuItem( MenuBar^.Menu, Event.Command ) else
CheckMenuItem( MenuBar^.Menu, Event.Command );
end;
TApplication.HandleEvent( Event );
end;
{ This method builds a menu structure in the same way as usual. The change
here is that instead of calling the NewItem function, the MenuTick function
NewCheckItem is used. If the Checked parameter is true then the item will
appear in the menu bar already checked. }
Procedure TMyApp.InitMenuBar;
var
R : TRect;
begin
GetExtent( R );
R.B.Y := R.A.Y+1;
MenuBar := New( PMenuBar, Init( R, NewMenu(
NewSubMenu( '~T~est', hcNoContext, NewMenu(
NewCheckItem( 'Menu Item ~1~', 'Alt-A', kbAltA,
cmMenuItem1, hcNoContext, False,
NewCheckItem( 'Menu Item ~2~', 'Alt-B', kbAltB,
cmMenuItem2, hcNoContext, False,
NewCheckItem( 'Menu Item ~3~', 'Alt-C', kbAltC,
cmMenuItem3, hcNoContext, True,
nil ) ) ) ),
NewItem( 'E~x~it', '', kbNoKey, cmQuit, hcNoContext, nil ) ) ) ) );
end;
var
MyApp : TMyApp;
begin
InitMessages;
MyApp.Init;
MyApp.Run;
MyApp.Done;
DoneMessages;
end.